perm filename BOOTFN.L70[L70,TES] blob
sn#017426 filedate 1972-12-13 generic text, type T, neo UTF8
00100 FUNCTION IN?$ATOM (TYPE TYP; STRING S) =
00200 FOR INTEGER NN ← FREE?$WORD(FORM?$FROM?$TYPE(TYP)) - 1 TO 0 BY -1
00300 SEARCH UNTIL S STRING?$EQUAL PNAME(DESCR(TYP, 0, NN))
00400 IN WHICH CASE DESCR(TYP, 0, NN) % ALREADY IN THE OBLIST %
00500 OTHERWISE LAMBDA(R); R([S,NIL]); (NAME(TYP)); % NOT IN THE OBLIST %
00600
00700
00800 FUNCTION IN?$NUMBER (BYTE?$VECTOR N) =
00900 BEGIN
01000 SHORT?$INTEGER I;
01100 INTEGER SUM, INT, FRAC, DIGITS, FRACDIGITS;
01200 BOOLEAN ISREAL, HASEXP;
01300 SUM ← DIGITS ← 0;
01400 FOR INTEGER I IN N DO
01500 IF I = UNASCII('?.) THEN
01600 BEGIN
01700 INT ← SUM; ISREAL ← T; SUM ← DIGITS ← 0;
01800 END
01900 ELSE IF I = UNASCII('E) THEN
02000 BEGIN
02100 IF PREFACE?$INCR > 0 THEN I ← FIND?$BACK?$POINTER(DATA) + (HAD+35)/36
02200 ALSO _BLT(PREFACE?$INCR, I, I+1) ; % ZERO OUT MARK BITS %
02300 HASEXP ← TRUE;
02400 IF ISREAL THEN
02500 BEGIN
02600 FRACDIGITS ← DIGITS;
02700 FRAC ← SUM;
02800 SUM ← DIGITS ← 0;
02900 END
03000 ELSE BEGIN
03100 INT ← SUM;
03200 SUM ← DIGITS ← 0;
03300 END
03400 END
03500 ELSE BEGIN
03600 DIGITS ← DIGITS + 1;
03700 SUM ← SUM*10 + I-UNASCII('0);
03800 END;
03900 RETURN IF ¬(HASEXP|ISREAL) THEN SUM
04000 ELSE IF ISREAL & ¬HASEXP THEN
04100 FLOAT(INT) + FLOAT(SUM)/EXP(10,DIGITS)
04200 ELSE IF ISREAL THEN
04300 (FLOAT(INT) + FLOAT(FRAC)/EXP(10,FRACDIGITS)) * EXP(10,SUM)
04400 ELSE INT * EXP(10,SUM);
04500 END;
04600
04700
04800 FUNCTION IN?$STRING (STRING N) = STRING(N);
04900
05000
05100
05200 FUNCTION intern (A) =
05300 IF NAME(TYPEF(A)) EQ 'identifier THEN A
05400 ELSE INTERN?$MAKNAM(PNAME(A));
05500
05600
05700 FUNCTION INTERN?$MAKNAM (STRING S) =
05800 IN?$ATOM('identifier.?&TYPE, S);
05900
06000
06100
06200
06300 FUNCTION MAKE?$FUNCTION (DESC; INTEGER LEN) =
06400 BEGIN INTEGER B;
06500 B ← GET?$BLOCK(DESC, 0, LEN, 0);
06600 _CORE(_EFFECTIVE(DESC), INTEGER) ← RIGHT?$HALF(B);
06700 RETURN DESC;
06800 END;
06900
07000
07100 FUNCTION MAKE?$HASHED?$STRINGS (TYPE TYP; INTEGER INIT, GROW) =
07200 BEGIN PRIVATE OBL;
07300 OBL ← RECORD(TYP, [0, GROW, MAKE?$WORD?$VECTOR(INIT,NIL), MAKE?$WORD?$VECTOR(INIT, NIL)]);
07400 RETURN OBL;
07500 END;
07600
07700
07800 FUNCTION MAKE?$L70?$ATOM(X) =
07900 % INTERN?$MAKNAM(string(STR(X))); %
08000 IF X.ATM THEN X.ATM ELSE X.ATM ← identifier(string(STR(X)), NIL); % FOR NOW %
08100
08200
08300 FUNCTION MAKE?$L70?$FUNCTION (X) =
08400 BEGIN PRIVATE TMP,M;
08500 TMP← MAKE?$L70?$ATOM(X);
08600 PROPERTIES(TMP) ← MAKE?$L70?$LIST(['FUNCTION, M ← MAKE?$ENTITY('identifier.?&TYPE)]);
08700 _CORE((M)) ← ['?&INSTRUCTION, '(JRST 0 UNDECLARED?$FUNCTION)];
08800 RETURN TMP;
08900 END;
09000
09100
09200 FUNCTION MAKE?$PROCESS (TYPE TYP; INTEGER VARS; INTEGER PSTACK?$SIZE) =
09300 BEGIN PRIVATE DATA, DESC; PRIVATE VALUE?$CELL VALCELL;
09400 DESC ← MAKE?$SOLITARY?$ENTITY(TYP, 1, 2*VARS);
09500 DATA ← DATA?$AREA(DESC);
09600 _CORE(DATA-2) ← 2*VARS; % SET LENGTH %
09700 VALCELL ← DATA ;
09800 VALUE(VALCELL) ← MAKE?$PUSHDOWN('STACK.?&TYPE, PSTACK?$SIZE); % SET UP THE P STACK %
09900 CONTEXT(VALCELL) ← CONTEXT;
10000 FOR INTEGER N ← DATA+3 TO DATA + 2*VARS BY 2 DO
10100 BEGIN
10200 VALCELL ← N;
10300 VALUE(VALCELL) ← 'UNBOUND;
10400 CONTEXT(VALCELL) ← CONTEXT;
10500 END;
10600 RETURN DESC;
10700 END;
10800
10900
11000 FUNCTION MAKE?$PUSHDOWN (TYPE TYP; INTEGER LEN) =
11100 BEGIN PRIVATE DESC; PRIVATE INTEGER BASE;
11200 DESC ← MAKE?$SOLITARY?$ENTITY(TYP, 1, LEN+1);
11300 BASE ← DATA?$AREA(DESC) ;
11400 _CORE(BASE-2) ← PDP10?$STACK?$POINTER(LEN, BASE); % STACK POINTER IS STORED IN BASE-2 %
11500 RETURN DESC;
11600 END;
11700
11800
11900 FUNCTION MAKE?$SOLITARY?$ENTITY (TYPE TYP; INTEGER PREFACE, DATA?$SIZE) =
12000 BEGIN PRIVATE DESC;
12100 DESC ← MAKE?$ENTITY(TYP); % GET A MAP TABLE CELL %
12200 GET?$BLOCK(DESC, PREFACE, DATA?$SIZE, 0) ;
12300 RETURN DESC;
12400 END;
12500
12600
12700 FUNCTION MAKE?$SYMBOL?$TABLE (INTEGER LEN) = MAKE?$PUSHDOWN('SYMBOL?$TABLE.?&TYPE, LEN);
12800
12900
13000 FUNCTION maknam (STRING S) = MADE?$NAME(S, NIL); % MADE?$NAME(STRING, PROPERTY LIST) %
13100
13200
13300
13400 FUNCTION ADD?$SYMBOL (NAME, VALU, TABLE) = PUSH(TABLE, [NAME, VALU]);
13500
13600
13700
00100 _EOF_